home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_d / rtdc.zip / TESTUNI1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-22  |  5KB  |  189 lines
  1. unit Testuni1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DB, DBTables, StdCtrls, ExtCtrls, Buttons,
  8.   RtDbCopy, Grids, DBGrids, Gauges;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     Database1: TDatabase;
  13.     Table1: TTable;
  14.     Table2: TTable;
  15.     Panel1: TPanel;
  16.     Label1: TLabel;
  17.     ComboBox1: TComboBox;
  18.     Edit1: TEdit;
  19.     Label2: TLabel;
  20.     BitBtn1: TBitBtn;
  21.     DataSource1: TDataSource;
  22.     DBGrid1: TDBGrid;
  23.     StringGrid1: TStringGrid;
  24.     BitBtn2: TBitBtn;
  25.     RtDbCopy1: TRtDbCopy;
  26.     Gauge1: TGauge;
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure RtDbCopy1Copy(Sender: TObject; Value: Integer;
  29.       var Cancel,Handled: Boolean);
  30.     procedure BitBtn1Click(Sender: TObject);
  31.     procedure ComboBox1Exit(Sender: TObject);
  32.     procedure BitBtn2Click(Sender: TObject);
  33.     procedure RtDbCopy1Error(Sender: TObject; E: Exception;
  34.       var Cancel: Boolean);
  35.     procedure RtDbCopy1Field(Sender: TObject; FieldNo: word; DataType: TFieldType;
  36.       Data: Pointer; var IsBlank: Boolean);
  37.   private
  38.     { Private-Deklarationen }
  39.   public
  40.     { Public-Deklarationen }
  41.   end;
  42.  
  43. var
  44.   Form1: TForm1;
  45.  
  46. implementation
  47.  
  48. uses
  49.    Login, Rt, TypInfo;
  50.  
  51. {$R *.DFM}
  52.  
  53. function SqlLogin(Database: TDatabase; AliasName,UserName,Password: string): Boolean;
  54. begin
  55.    if Database.Connected then
  56.       Database.Close;
  57.    Database.AliasName := AliasName;
  58.    Database.Params.Values['USER NAME'] := UserName;
  59.    Database.Params.Values['PASSWORD'] := Password;
  60.    Database.Open;
  61.    Result := Database.Connected;
  62. end;
  63.  
  64. procedure TForm1.FormCreate(Sender: TObject);
  65. var
  66.     List: TStringList;
  67. begin
  68.    if not Database1.Connected then
  69.    begin
  70.       LoginForm := TLoginForm.Create(Application);
  71.       try
  72.          if LoginForm.ShowModal=idOK then
  73.             try
  74.                SqlLogin(Database1,LoginForm.Alias,LoginForm.User,LoginForm.Password);
  75.             except
  76.                if (not Database1.Connected) then
  77.                   raise EDatabaseError.Create('Login fehlgeschlagen !');
  78.             end;
  79.       finally
  80.          LoginForm.Release;
  81.       end;
  82.    end;
  83.    if Database1.Connected then
  84.    begin
  85.        List := TStringList.Create;
  86.        Session.GetTableNames(Database1.DatabaseName,'',True,False,List);
  87.       ComboBox1.Items.Assign(List);
  88.       List.Free;
  89.    end;
  90. end;
  91.  
  92. procedure TForm1.RtDbCopy1Copy(Sender: TObject; Value: Integer;
  93.   var Cancel,Handled: Boolean);
  94. begin
  95.     Case Value of
  96.        0:    begin
  97.                Gauge1.MinValue := 0;
  98.               Gauge1.MaxValue := Table1.RecordCount;
  99.               Gauge1.Progress := 0;
  100.               Gauge1.Visible := True;
  101.          end;
  102.    else
  103.         Gauge1.AddProgress(1);
  104.    end;
  105. end;
  106.  
  107. procedure TForm1.BitBtn1Click(Sender: TObject);
  108. var
  109.     n: integer;
  110.    Mapping: string;
  111. begin
  112.    StringGrid1.Visible := False;
  113.    Gauge1.Visible := False;
  114.    if Table2.Active then
  115.        Table2.Close;
  116.     Table2.TableName := Edit1.Text;
  117.    RtDbCopy1.Mappings.Clear;
  118.    for n:=1 to StringGrid1.RowCount-1 do
  119.    begin
  120.        if Pos('STRING',UpperCase(StringGrid1.Cells[3,n]))>0 then
  121.           Mapping := '*'
  122.       else
  123.           Mapping := '';
  124.       Mapping := Mapping+StringGrid1.Cells[2,n]+':'+StringGrid1.Cells[3,n]+'='+StringGrid1.Cells[0,n];
  125.       RtDbCopy1.Mappings.Add(Mapping);
  126.    end;
  127.    try
  128.        RtDbCopy1.Execute;
  129.        Gauge1.Visible := False;
  130.        Table2.Open;
  131.        DbGrid1.Visible := True;
  132.    finally
  133.        if not DbGrid1.Visible then
  134.          StringGrid1.Visible := True;
  135.    end;
  136. end;
  137.  
  138. procedure TForm1.ComboBox1Exit(Sender: TObject);
  139. var
  140.     n: integer;
  141. begin
  142.     if Table1.TableName=ComboBox1.Text then
  143.        exit;
  144.     DbGrid1.Visible := False;
  145.     StringGrid1.Visible := True;
  146.     if Table1.Active then
  147.        Table1.Close;
  148.     Table1.TableName := ComboBox1.Text;
  149.     Table1.Open;
  150.    StringGrid1.ColCount := 4;
  151.    StringGrid1.RowCount := Table1.FieldCount+1;
  152.    for n:=0 to Table1.FieldCount-1 do
  153.    begin
  154.       StringGrid1.Cells[0,n+1] := Table1.Fields[n].FieldName;
  155.       StringGrid1.Cells[2,n+1] := Table1.Fields[n].FieldName;
  156.       StringGrid1.Cells[1,n+1] := GetEnumName(TypeInfo(TFieldType),integer(Table1.Fields[n].DataType))^;
  157.       StringGrid1.Cells[3,n+1] := StringGrid1.Cells[1,n+1];
  158.    end;
  159.    StringGrid1.Cells[0,0] := 'Source Field Names';
  160.    StringGrid1.Cells[1,0] := 'Source Data Type';
  161.    StringGrid1.Cells[2,0] := 'Destination Field Names';
  162.    StringGrid1.Cells[3,0] := 'Destination Data Type';
  163.    StringGrid1.Visible := True;
  164. end;
  165.  
  166. procedure TForm1.BitBtn2Click(Sender: TObject);
  167. begin
  168.     Close;
  169. end;
  170.  
  171. procedure TForm1.RtDbCopy1Error(Sender: TObject; E: Exception;
  172.   var Cancel: Boolean);
  173. begin
  174.     if MessageDlg('Error copying file: '+Table1.TableName+' in record#: '+IntToStr((Sender as TRtDbCopy).CopyNo)+
  175.                  #13#10+E.Message,mtError,mbOkCancel,0)=mrOk then
  176.       Cancel := False;
  177. end;
  178.  
  179. procedure TForm1.RtDbCopy1Field(Sender: TObject; FieldNo: word; DataType: TFieldType;
  180.   Data: Pointer; var IsBlank: Boolean);
  181. begin
  182.     if not IsBlank then
  183.         case DataType of
  184.            ftString: StrUpper(Data);
  185.        end;
  186. end;
  187.  
  188. end.
  189.